home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / butt01.zip / BUTTMAIN.INC < prev    next >
Text File  |  1993-01-04  |  22KB  |  618 lines
  1. <<* ButtMain.Inc  *>>
  2. <<#
  3.  
  4. <<*===================================================================*>>
  5. procedure ProgramBody( procfile : string )
  6. <<*===================================================================*>>
  7. string  fuser,HighLite,Temp,box,VersionName,HotKeys
  8. integer Tmp,Tmp2,TopRowBox,BoxWidth,CodeLines,ColOffset,RowOffset
  9. integer WindowBot,RightMarg,MenuItems,CodeStart,ScrnOfSet
  10. logical FoxPro
  11.  
  12.  
  13. begin
  14. VersionName := 'Button Menu Ver(1) 4/4/90 *CAB*'
  15. lasthue := 0     <<*  Color test variable *>>
  16. <<**Start Comment**
  17.                   Get User Area of Box
  18.      <Flag>;<HighLite Color>;
  19.      Example:   W;GR+/N;
  20. **End Comment**>>
  21. select all
  22. <<* Get window parameters from BOX *>>
  23. SELECT FIELDS ON fldtyp = 'B'
  24. <<* ------------------------------------------- *>>
  25. <<*  Begin test of first box object & get info  *>>
  26. <<*  Assumes the first box object is the window *>>
  27. if fldtyp <> 'B'
  28.    WAIT 'No Box defined!! Generation terminated.'
  29.    HALT  
  30. endif
  31. if upper(left(fldusr,1))<>'W'
  32.    WAIT 'First Box is not defined with the "W" flag! Generation terminated.'
  33.    HALT  
  34. endif
  35. TopRowBox := fldrow  
  36. WindowBot := flddec   <<*  rows in the window including borders  *>>
  37. fuser := fldusr
  38. <<* Get HighLite Color from User Area *>>
  39. HighLite := GetUser(2,fuser)
  40. if (HighLite="") or (HighLite="MAIN") <<*  get field color from box object *>>
  41.    HighLite := AtrCode( fldatr )
  42. endif
  43. <<*  End test of first box object & get info  *>>
  44. <<* ----------------------------------------- *>>
  45. Tmp := 1
  46. INITMENU('[ TARGET LANGUAGE ]')
  47. '1. FoxPro':'Generate code for FoxPro.'
  48. '2. FoxBase+':'Generate code for FoxBase+ Version 2.1'
  49. END
  50. MENU TO Tmp
  51. if Tmp = 0
  52.    HALT
  53. endif
  54. FoxPro := (Tmp=1)
  55. <<*  WARNING - the follwing relies on the box obj located by the code
  56.                above, so do not use a SELECT ALL between them  *>>
  57. if FoxPro
  58.    ColOffset := fldcol
  59.    RowOffset := fldrow
  60. else
  61.    ColOffset := 0
  62.    RowOffset := 0
  63. endif
  64. <<* Get Field Colors and the primary row *>>
  65. MenuItems := 0
  66. select all
  67. forall fields  <<* Count Menu Items *>>
  68.    temp := upper(left(fldusr,1))
  69.    if (temp$'BCMOE') and (temp<>'')
  70.       MenuItems := MenuItems +1
  71.    endif
  72. endfor
  73. #>>
  74. <<*  
  75. *>-------------------------------------------------------------------<*
  76. *>       *****  USER AREA FLAGS TO ACTIVATE MENU CHOICES  *****
  77. *>  
  78. *>    <Type Flag>;<Hot Key Color>;<Default Value>;<Action when tagged True>
  79. *>  
  80. *>    Check Box, with a 'w/r' Hot Button color, an initial value of true,
  81. *>       and an xBase prg call.
  82. *>    C;w/r;T;DO Gc_Tag
  83. *>  
  84. *>    Button Group 1 with the 2nd button set ON
  85. *>    B1;;
  86. *>    B1;;T;
  87. *>    B1;;
  88. *>  
  89. *>    Text Button for Normal exit 
  90. *>    OK;;<Exit Code>
  91. *>  
  92. *>    Text Button For Cancel Operation
  93. *>    ESC;;<Exit Code>
  94. *>  
  95. *>    Text Button for Menu Action
  96. *>    M;;<xBase Code>
  97. *>  
  98. *>-------------------------------------------------------------------<*
  99. *>>
  100. #>>
  101. <<* ====================================================================
  102.                         xBASE PROGRAM START
  103.     ====================================================================*>>
  104. <<* The "program" label returns the current program filename being generated *>>
  105. <<filespec( program,fpath,fname,fext )>>
  106. <<*---Rebuild the program filename without the PATH---*>>
  107. <<prgname := fname + '.' + fext>>
  108. * Program.: {prgname}
  109. * Author..: {Author}
  110. * Date....: {date}
  111. * Notice..: Copyright (c) 1990, <<gen(Rtrim(Copyright))>>, All Rights Reserved
  112. * Notes...: Template {VersionName}     
  113. <<# pragma
  114. if FoxPro
  115.    genln('* Notes...: Target Language is FoxPro.')
  116. else
  117.    genln('* Notes...: Target Language is FoxBase Version 2.1 .')
  118. endif
  119. genln('****  Debug  *****')
  120. genln('DO set_fox')
  121. genln('DO mis_logo')
  122. genln('****  Debug  *****')
  123. genln('** -- Save some of the calling environment')
  124. if FoxPro
  125.    genln('ButtSch1=SCHEME(1)  &&  SAVE Colors   [FoxPro]')
  126.    genln('ButtSch2=SCHEME(2)  &&  SAVE Colors   [FoxPro]')
  127. else
  128.    genln('SAVE SCREEN TO ButtScrn')
  129.    genln('ButtColor=SYS(2001,"COLOR")  &&  SAVE Colors     [Fox 2.1]')
  130.    genln('Null = SYS(2002)        &&  Turn the cursor off  [Fox 2.1]')
  131. endif
  132. #>>
  133. **  --  Declare private variables
  134. PRIVATE ButRef,ButtColor,ButtScrn,cnt,ColorStr,LastColor
  135. PRIVATE Mpt,MaxMpt,SayString
  136.  
  137. DIMENSION GroupFlag({MenuItems})
  138. **  Flag Groups as follows
  139. **  Value of  1 to n  = Radio Button Groups
  140. **  Value of  0 = Check Box
  141. **  Value of -1 = Proceed Text Button
  142. **  Value of -2 = Abort Text Button
  143. **  Value of -3 = Menu Choice Text Button
  144. <<select all>>
  145. <<tmp := 1>>
  146. <<forall fields>>    <<*  Build Group Flag Array  *>>
  147.    <<temp := upper(left(fldusr,1))>>
  148.    <<if (temp$'BCMOE') and (temp<>'')>>
  149.       <<gen('GroupFlag(',str(tmp,2),')=')>>
  150.       <<if temp='B'>>
  151.          <<genln(substr(fldusr,2,1),'     &&  Button Group')>>
  152.       <<elseif temp='C'>>
  153.          <<genln('0     &&  Check Box')>>
  154.       <<elseif temp='O'>>
  155.          <<genln('-1    &&  Proceed')>>
  156.       <<elseif temp='E'>>
  157.          <<genln('-2    &&  ESCape')>>
  158.       <<elseif temp='M'>>
  159.          <<genln('-3    &&  Menu Item')>>
  160.       <<endif>>
  161.       <<tmp := tmp +1>>
  162.    <<endif>>
  163. <<endfor>>
  164.  
  165. **  Set true defaults, one per Radio Group
  166. <<gen("IF TYPE('T_F(",MenuItems,")') # 'L'  && Skip if already defined")>>
  167.    RELEASE T_F
  168.    PUBLIC T_F({MenuItems})
  169. <<tmp := 1>>
  170. <<SetIndent(1)>>
  171. <<select all>>
  172. <<forall fields>>    <<*  Build Array of defaults set True  *>>
  173.    <<temp := upper(left(fldusr,1))>>
  174.    <<if (temp$'BCMOE') and (temp<>'')>>
  175.       <<if (temp$'BC') and (GetUser(3,fldusr)$'Tt') and not (GetUser(3,fldusr)='')>>
  176.          <<gen('T_F(',str(tmp,2),')=.T.   &&  ')>>
  177.          <<if temp='B'>>
  178.             <<genln('Button Group ',substr(fldusr,2,1))>>
  179.          <<elseif temp='C'>>
  180.             <<genln('Check Box')>>
  181.          <<endif>>
  182.       <<endif>>
  183.       <<tmp := tmp +1>>
  184.    <<endif>>
  185. <<endfor>>
  186. <<RestoreIndent(1)>>
  187. ENDIF
  188.  
  189. IF TYPE('Ky') # 'N'  && Skip if already defined
  190.    RELEASE Ky
  191.    PUBLIC Ky         &&  Returns the ASCII number of the exit key
  192. ENDIF
  193.  
  194. DIMENSION SayAry({MenuItems})    &&  --  Array Used to Display Choices  --
  195. DIMENSION HotKey({MenuItems})    &&  --  Array Used to Display Hot Keys  --
  196. <<tmp := 1>>
  197. <<forall fields>>    <<*  Build Both Arrays  *>>
  198.    <<temp := upper(left(fldusr,1))>>
  199.    <<if (temp$'BCMOE') and (temp<>'')>>
  200.       <<gen('SayAry(',str(tmp,2),')=')>>
  201.       <<gen("'")>>
  202.       <<gen('@ ',str(fldrow-RowOffset,2),',',str(fldcol-ColOffset,2),' SAY ')>>
  203.       <<if (at('\<',fldlab)>0)>>     <<*  Hot Key Flag  *>>
  204.          <<temp := stuff(fldlab,at('\<',fldlab),2,'')>>
  205.          <<gen('"',temp,'"')>>
  206.          <<genln("'")>>
  207.          <<HotKeys := HotKeys + upper(substr(fldlab,at('\<',fldlab)+2,1))>>
  208.          <<gen('HotKey(',tmp,') = "',substr(fldlab,at('\<',fldlab)+2,1))>>
  209.          <<genln(str(at('\<',fldlab)+fldcol-1-ColOffset,2),GetUser(2,fldusr),'"')>>
  210.       <<else>>
  211.          <<HotKeys := HotKeys + '.'>>
  212.          <<gen('"',fldlab,'"')>>
  213.          <<genln("'")>>
  214.       <<endif>>
  215.       <<tmp := tmp +1>>
  216.    <<endif>>
  217. <<endfor>>
  218. <<genln('HotKeys = "',HotKeys,'"')>>
  219.  
  220. **  --  Color of Menu Choice  --
  221. DIMENSION SayColor({MenuItems})
  222. <<tmp := 1>>
  223. <<forall fields>>
  224.    <<temp := upper(left(fldusr,1))>>
  225.    <<if (temp$'BCMOE') and (temp<>'')>>
  226.       <<genln("SayColor(",str(tmp,2),")='",AtrCode(fldhue),"'")>>
  227.       <<tmp := tmp +1>>
  228.    <<endif>>
  229. <<endfor>>
  230.  
  231. * --- Paints titles & borders on the screen
  232. <<* Generate a group of SAYs for field labels and text objects *>>
  233. <<#
  234. forall fldlab
  235.    temp := upper(left(fldusr,1))
  236.    if (temp='' or (not temp$'BCMOE')) and not fldnap
  237.       GenColorHue      <<*  Test for color change *>>
  238.       if fldtyp = 'B'  <<*BOX Type*>>
  239.          if FoxPro and (upper(left(fldusr,1))='W')
  240.             genln('**  --  Set Size of Display Windows  --  **')
  241.             gen('DEFINE WINDOW Button FROM ',fldrow,',',fldcol)
  242.             genln(' TO ',fldrow+flddec,',',fldcol+fldwid,' none')
  243.             genln('ACTIVATE WINDOW Button ')
  244.          endif
  245.          box := fldlab  <<*Used to swap chars for Character box*>>
  246.          gen( '@ ',fldrow-RowOffset,',',fldcol-ColOffset,',' )
  247.          gen( fldrow+flddec-RowOffset,',',fldcol+fldwid-ColOffset,' BOX "' )
  248.          genln( substr(box,1,3),box[5],box[8],box[7],box[6],box[4],' "' )
  249.       else  <<*All Fields and Text Objects*>>
  250.         genln( '@ ',str(fldrow-RowOffset,2),',',str(fldcol-ColOffset,2),' SAY "',fldlab,'"' )
  251.       endif
  252.    endif not fldnap
  253. endfor
  254. if FoxPro
  255.    genln('@  0, 0 SAY CHR(254)   &&  Close window icon')  
  256. endif
  257. #>>
  258. **  --  Local Variables
  259. Mpt = 1        &&  Menu Pointer
  260. MptMax = {MenuItems}    &&  Last Menu Choice
  261. LastColor=''   &&  Last Color Set
  262.  
  263. cnt =1
  264. DO WHILE cnt <= MptMax        &&  Display Menu Choices
  265.    IF GroupFlag(cnt) < 0      &&  Re-set text button flags
  266.       T_F(cnt) = .F.
  267.    ENDIF
  268.    IF GroupFlag(cnt) >= 0
  269.       SayAry(cnt)=STUFF(SayAry(cnt),15,1,IIF(T_F(cnt),IIF(GroupFlag(cnt)=0,'X','*'),' '))
  270.    ENDIF
  271. <<if FoxPro>>
  272.    IF LastColor # SayColor(cnt)
  273.       SET COLOR TO &SayColor(cnt)
  274.       LastColor = SayColor(cnt)
  275.    ENDIF
  276.    &SayAry(cnt)
  277. <<else>>       <<*  FoxBase will not allow arrays in macros  *>>
  278.    ColorStr = SayColor(cnt)
  279.    IF LastColor # ColorStr
  280.       SET COLOR TO &ColorStr
  281.       LastColor = ColorStr
  282.    ENDIF
  283.    SayString = SayAry(cnt)
  284.    &SayString
  285. <<endif>>
  286.    IF SUBSTR(HotKeys,cnt,1) # '.'      &&  Display Hot Key
  287.       ColorStr = SUBSTR(HotKey(cnt),4)
  288.       SET COLOR TO &ColorStr
  289.       @ ROW(),VAL(SUBSTR(HotKey(cnt),2,2)) SAY SUBSTR(HotKey(cnt),1,1)
  290.       LastColor = ColorStr
  291.    ENDIF
  292.  
  293.    cnt = cnt +1
  294. ENDDO
  295.  
  296. DO WHILE .T.
  297.    **  ----------  Display Highlite and get key press  ------------
  298.    SET COLOR TO {HighLite}
  299. <<if FoxPro>>
  300.    &SayAry(Mpt)                  &&  Display Highlite
  301.    Ky = INKEY(0,'MH')            &&  Get Key Press   ******************
  302.    SET COLOR TO &SayColor(Mpt)   &&  Color
  303.    &SayAry(Mpt)                  &&  Turn Highlite Off
  304.    IF SUBSTR(HotKeys,Mpt,1) # '.'      &&  Display Hot Key
  305.       ColorStr = SUBSTR(HotKey(Mpt),4)
  306.       SET COLOR TO &ColorStr
  307.       @ ROW(),VAL(SUBSTR(HotKey(Mpt),2,2)) SAY SUBSTR(HotKey(Mpt),1,1)
  308.       LastColor = ColorStr
  309.    ENDIF
  310.    IF Ky = 151    &&  Mouse Click, so decode
  311.       Ky = 13
  312.       DO CASE
  313.       CASE MROW() = 0 .AND. MCOL() = 0
  314.          Ky = 27     &&  ESCape
  315.    <<tmp := 1>>
  316.    <<SetIndent(2)>>
  317.    <<forall fields>>    <<*  Build Mouse Decode Logic  *>>
  318.       <<temp := upper(left(fldusr,1))>>
  319.       <<if (temp$'BCMOE') and (temp<>'')>>
  320.          <<gen("CASE MROW() = ",str(fldrow-RowOffset,2)," .AND. MCOL()>= ")>>
  321.          <<gen(str(fldcol-ColOffset,2))>>
  322.          <<if '>\' $ fldlab>>
  323.             <<tmp2 := len(fldlab)-2>>
  324.          <<else>>
  325.             <<tmp2 := len(fldlab)>>
  326.          <<endif>>
  327.          <<genln(" .AND. MCOL() <= ",str(fldcol+tmp2-ColOffset,2))>>
  328.          <<genln('   Mpt = ',tmp)>>
  329.          <<tmp := tmp +1>>
  330.       <<endif>>
  331.    <<endfor>>
  332.    <<RestoreIndent(2)>>
  333.       OTHERWISE
  334.          LOOP
  335.       ENDCASE
  336.    ENDIF Ky = 151    &&  Mouse Click
  337. <<else>>
  338.    SayString = SayAry(Mpt)
  339.    &SayString                &&  Display Highlite
  340.    Ky = INKEY(0)             &&  Get Key Press   ******************
  341.    ColorStr = SayColor(Mpt)  &&  Color
  342.    SET COLOR TO &ColorStr
  343.    &SayString                &&  Turn Highlite Off
  344.    IF SUBSTR(HotKeys,Mpt,1) # '.'      &&  Display Hot Key
  345.       ColorStr = SUBSTR(HotKey(Mpt),4)
  346.       SET COLOR TO &ColorStr
  347.       @ ROW(),VAL(SUBSTR(HotKey(Mpt),2,2)) SAY SUBSTR(HotKey(Mpt),1,1)
  348.       LastColor = ColorStr
  349.    ENDIF
  350. <<endif>>
  351.    
  352.    **  --  Test for Hot Key  --
  353.    IF Ky > 32 .AND. Ky < 127     &&  ASCII key pressed
  354.       IF Ky > 96
  355.          Ky = Ky -32 &&  Convert to Upper Case
  356.       ENDIF
  357.       IF CHR(Ky) $ HotKeys       &&  Hot Key found
  358.          Mpt = AT(CHR(Ky),HotKeys)
  359.          Ky =32
  360.       ENDIF
  361.    ENDIF
  362.  
  363.    **  ----------------  Process KEY strokes  ---------------------
  364.    DO CASE
  365.    CASE Ky=5.OR.Ky=56.OR.Ky=19.OR.Ky=52            &&  [Up]  [Left]
  366.       Mpt = IIF(Mpt=1,MptMax,Mpt-1)
  367.       
  368.    CASE Ky=24.OR.Ky=50.OR.Ky=4.OR.Ky=54            &&  [Down]  [Right]
  369.       Mpt = IIF(Mpt=MptMax,1,Mpt+1)
  370.       
  371.    CASE Ky = 9                                     &&  Tab to next group
  372.       cnt = Mpt
  373.       ButRef = GroupFlag(Mpt)
  374.       DO WHILE cnt <= MptMax
  375.          IF GroupFlag(cnt) # ButRef
  376.             Mpt = cnt
  377.             EXIT
  378.          ENDIF
  379.          cnt = cnt +1
  380.       ENDDO
  381.       Mpt = IIF(cnt>MptMax,1,Mpt)
  382.       
  383.    CASE Ky = 15                                    &&  Shift Tab prev group
  384.       cnt = Mpt
  385.       ButRef = GroupFlag(Mpt)
  386.       DO WHILE cnt >= 1
  387.          IF GroupFlag(cnt) # ButRef
  388.             Mpt = cnt
  389.             EXIT
  390.          ENDIF
  391.          cnt = cnt -1
  392.       ENDDO
  393.       Mpt = IIF(cnt<1,MptMax,Mpt)
  394.       
  395.    CASE Ky = 27                                    &&  ESCape
  396. <<select all>>
  397. <<tmp := 1>>
  398. <<SetIndent(2)>>
  399. <<forall fields>>
  400.    <<temp := upper(left(fldusr,1))>>
  401.    <<if (temp$'BCMOE') and (temp<>'')>>  <<* loop all to keep counter correct *>>
  402.       <<if (temp='E')>>
  403.          <<genln('T_F(',tmp,') = .T.')>>
  404.          <<CodeLines := HowMany(';',fldusr)-1>>  <<*  1st two are flags  *>>
  405.          <<if (CodeLines>0) and (len(GetUser(3,fldusr))>0)>>
  406.             <<CodeStart := 3>>
  407.             <<while CodeLines > 0>>    <<*  Gen xBase Code Lines  *>>
  408.                <<genln('   ',GetUser(CodeStart,fldusr))>>               
  409.                <<CodeStart := CodeStart +1>>
  410.                <<CodeLines := CodeLines -1>>
  411.             <<end>>
  412.          <<endif>>
  413.       <<endif>>
  414.       <<tmp := tmp +1>>
  415.    <<endif>>
  416. <<endfor>>
  417. <<RestoreIndent(2)>>
  418.       EXIT     &&  --  MENU Exit to abort
  419.       
  420.    CASE Ky = 23 .OR. Ky = 10                       &&  Ctrl-End or Ctrl-Enter
  421.       Ky = 10     &&  Force to Ctrl-Enter code
  422. <<select all>>
  423. <<tmp := 1>>
  424. <<SetIndent(2)>>
  425. <<forall fields>>
  426.    <<temp := upper(left(fldusr,1))>>
  427.    <<if (temp$'BCMOE') and (temp<>'')>>  <<* loop all to keep counter correct *>>
  428.       <<if (temp='O')>>
  429.          <<genln('T_F(',tmp,') = .T.')>>
  430.          <<CodeLines := HowMany(';',fldusr)-1>>  <<*  1st two are flags  *>>
  431.          <<if (CodeLines>0) and (len(GetUser(3,fldusr))>0)>>
  432.             <<CodeStart := 3>>
  433.             <<while CodeLines > 0>>    <<*  Gen xBase Code Lines  *>>
  434.                <<genln('   ',GetUser(CodeStart,fldusr))>>               
  435.                <<CodeStart := CodeStart +1>>
  436.                <<CodeLines := CodeLines -1>>
  437.             <<end>>
  438.          <<endif>>
  439.       <<endif>>
  440.       <<tmp := tmp +1>>
  441.    <<endif>>
  442. <<endfor>>
  443. <<RestoreIndent(2)>>
  444.       EXIT     &&  --  MENU Exit to proceed
  445.       
  446.    CASE Ky=28.OR.Ky=72.OR.Ky=104                   &&  [F1] [Hh]  Help
  447.       **  put up the window
  448.       SET COLOR TO RB+/N
  449.    <<if FoxPro>>
  450.       DEFINE WINDOW ButHelp FROM 2,10 TO 20,68  ;
  451.              TITLE '[ Control Panel Help ]' DOUBLE ;
  452.              COLOR G+/N,RB+/N,RB+/N
  453.       ACTIVATE WINDOW ButHelp
  454.       <<ScrnOfSet := 2>>
  455.    <<else>>
  456.       SAVE SCREEN TO F1Screen
  457.       @ 6,10,21,66 BOX '╔═╗║╝═╚║ '
  458.       @ 6,27 SAY '[ Control Panel Help ]'
  459.       <<ScrnOfSet := 12>>
  460.    <<endif>>
  461.       @ ROW()+1,{ScrnOfSet} SAY 'The following keys are active while using this panel.'
  462.       @ ROW()+1,{ScrnOfSet} SAY '--------KEY------ACTION------------------------------'
  463.       @ ROW()+1,{ScrnOfSet} SAY '      [Enter]  Select the item highlighted.'
  464.       @ ROW()+1,{ScrnOfSet} SAY '      [Space]  Select the item highlighted.'
  465.       @ ROW()+1,{ScrnOfSet} SAY '[Ctrl][Enter]  Exit the menu and proceed.'
  466.       @ ROW()+1,{ScrnOfSet} SAY '  [Ctrl][End]  Exit the menu and proceed.'
  467.       @ ROW()+1,{ScrnOfSet} SAY '        [ESC]  Exit without selecting.'
  468.       @ ROW()+1,{ScrnOfSet} SAY '     [Arrows]  Up/Down, move the highlighted item.'
  469.       @ ROW()+1,{ScrnOfSet} SAY '     [Arrows]  Right/Left, move the highlighted item.'
  470.       @ ROW()+1,{ScrnOfSet} SAY '        [Tab]  Move Highlight forward one group'
  471.       @ ROW()+1,{ScrnOfSet} SAY ' [Shift][Tab]  Move Highlight back one group'
  472.       @ ROW()+1,{ScrnOfSet} SAY '       [Home]  Go to the first item.'
  473.       @ ROW()+1,{ScrnOfSet} SAY '        [End]  Go to the last item.'
  474.       @ ROW()+1,{ScrnOfSet} SAY '         [F1]  Displays this screen.'
  475.       @ ROW()+1,{ScrnOfSet}+14 SAY '<Press Any Key To Return>'
  476.    <<if FoxPro>>
  477.       cnt=INKEY(0,'HM')
  478.       RELEASE WINDOWS ButHelp
  479.       ACTIVATE WINDOW Button
  480.    <<else>>
  481.       cnt=INKEY(0)    &&  wait for key press
  482.       RESTORE SCREEN FROM F1Screen
  483.    <<endif>>
  484.       
  485.    CASE Ky = 1 .OR. Ky = 55                        &&  Home
  486.       Mpt = 1
  487.       
  488.    CASE Ky = 6 .OR. Ky = 49                        &&  End
  489.       Mpt = MptMax
  490.       
  491.    CASE Ky = 13 .OR. Ky = 32                       &&  ENTER or SPACE
  492.       IF GroupFlag(Mpt) >= 0   &&  Is Button or Check Box
  493.          **  No action if Button is ON
  494.          IF GroupFlag(Mpt) = 0 .OR. .NOT. T_F(Mpt)
  495.  
  496.             DO CASE      &&  Tag Action Initiated Here
  497. <<*  Action that cause a prg call or other xBase code, Radio & Check Only  *>>
  498. <<select all>>
  499. <<tmp := 1>>
  500. <<SetIndent(4)>>
  501. <<forall fields>>
  502.    <<temp := upper(left(fldusr,1))>>
  503.    <<if (temp$'BCMOE') and (temp<>'')>>  <<* loop all to keep counter correct *>>
  504.       <<if (temp$'BC')>>
  505.          <<CodeLines := HowMany(';',fldusr) -2>>  <<*  1st 3 are flags  *>>
  506.          <<if (CodeLines>0) and (len(GetUser(4,fldusr))>0)>>
  507.             <<genln('CASE Mpt=',tmp)>>
  508.             <<if not FoxPro>>
  509.                <<genln('   SAVE SCREEN TO ButScrn')>>
  510.             <<endif>>
  511.             <<CodeStart := 4>>
  512.             <<while CodeLines > 0>>
  513.                <<genln('   ',GetUser(CodeStart,fldusr))>>               
  514.                <<CodeStart := CodeStart +1>>
  515.                <<CodeLines := CodeLines -1>>
  516.             <<end>>
  517.             <<if FoxPro>>
  518.                <<genln('   ACTIVATE WINDOW Button')>>
  519.             <<else>>
  520.                <<genln('   RESTORE SCREEN FROM ButScrn')>>
  521.             <<endif>>
  522.          <<endif>>
  523.       <<endif>>
  524.       <<tmp := tmp +1>>
  525.    <<endif>>
  526. <<endfor>>
  527. <<RestoreIndent(4)>>
  528.             ENDCASE
  529.  
  530.             **  Set True / False Flag
  531.             T_F(Mpt) = IIF(GroupFlag(Mpt)#0,.T.,.NOT.T_F(Mpt))
  532.  
  533.             **  Set  display of button On or Off
  534.             SayAry(Mpt)=STUFF(SayAry(Mpt),15,1,IIF(T_F(Mpt),IIF(GroupFlag(Mpt)=0,'X','*'),' '))
  535.  
  536.             **  If Button, Need to clear all buttons in this group
  537.             IF GroupFlag(Mpt) # 0   && Ignore if Check Box
  538.                ButRef= GroupFlag(Mpt)   &&  Button Reference
  539.                cnt =1
  540.                DO WHILE cnt <= MptMax
  541.                   IF GroupFlag(cnt) = ButRef      &&  Button group match
  542.                      IF cnt # Mpt      &&  Clear Button
  543.                         T_F(cnt) = .F.
  544.                         SayAry(cnt)=STUFF(SayAry(cnt),15,1,' ')
  545.                      ENDIF
  546.                      ColorStr = SayColor(cnt)
  547.                      IF LastColor # ColorStr
  548.                         SET COLOR TO &ColorStr
  549.                         LastColor = ColorStr
  550.                      ENDIF
  551.                      SayString = LEFT(SayAry(cnt),15)+'"'
  552.                      &SayString             &&  Display Menu Choice
  553.                   ENDIF
  554.                   cnt = cnt +1
  555.                ENDDO
  556.             ENDIF
  557.          ENDIF
  558.       ELSE              &&  EXIT or Menu Choice
  559.          DO CASE
  560. <<select all>>
  561. <<tmp := 1>>
  562. <<SetIndent(3)>>
  563. <<forall fields>>
  564.    <<temp := upper(left(fldusr,1))>>
  565.    <<if (temp$'BCMOE') and (temp<>'')>>
  566.       <<if temp='O'>>
  567.          <<genln('CASE GroupFlag(Mpt) = -1')>>
  568.          <<genln('   KEYBOARD CHR(10)')>>
  569.       <<elseif temp='E'>>
  570.          <<genln('CASE GroupFlag(Mpt) = -2')>>
  571.          <<genln('   KEYBOARD CHR(27)')>>
  572.       <<elseif temp='M'>>
  573.          <<CodeLines := HowMany(';',fldusr)-1>>  <<*  1st 2 are flags  *>>
  574.          <<if (CodeLines>0) and (len(GetUser(3,fldusr))>0)>>
  575.             <<genln('CASE Mpt=',tmp)>>
  576.             <<if not FoxPro>>
  577.                <<genln('   SAVE SCREEN TO ButScrn')>>
  578.             <<endif>>
  579.             <<CodeStart := 3>>
  580.             <<while CodeLines > 0>>
  581.                <<genln('   ',GetUser(CodeStart,fldusr))>>               
  582.                <<CodeStart := CodeStart +1>>
  583.                <<CodeLines := CodeLines -1>>
  584.             <<end>>
  585.             <<if FoxPro>>
  586.                <<genln('   ACTIVATE WINDOW Button')>>
  587.             <<else>>
  588.                <<genln('   RESTORE SCREEN FROM ButScrn')>>
  589.             <<endif>>
  590.          <<endif>>
  591.       <<endif>>
  592.       <<tmp := tmp +1>>
  593.    <<endif>>
  594. <<endfor>>
  595. <<RestoreIndent(3)>>
  596.          ENDCASE
  597.       ENDIF
  598.    ENDCASE
  599. ENDDO    &&  ------------------ Main Loop ---------------------------
  600.  
  601. * ---Closing operations.
  602. <<#
  603. if FoxPro
  604.    genln('RELEASE WINDOW Button')
  605.    genln('SET COLOR OF SCHEME 1 TO &ButtSch1  &&  Restore Colors   [FoxPro]')
  606.    genln('SET COLOR OF SCHEME 2 TO &ButtSch2  &&  Restore Colors   [FoxPro]')
  607. else
  608.    genln('SET COLOR TO &ButtColor')
  609.    genln('RESTORE SCREEN FROM ButtScrn')
  610.    genln('Null = SYS(2002,1)        &&  Turn the cursor on       [Fox 2.1]')
  611. endif
  612. #>>
  613. RETURN
  614. * EOF: {prgname}
  615. <<end>> <<*ProgramBody*>>
  616.  
  617. <<* ButtMAIN.INC *>>
  618.